home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / gsdb25.zip / GS_DBNDX.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-01  |  63KB  |  1,387 lines
  1. {
  2.                            dBase III Index Handler
  3.  
  4.        GS_DBNdx Copyright (c)  Richard F. Griffin
  5.  
  6.        15 November 1990
  7.  
  8.        102 Molded Stone Pl
  9.        Warner Robins, GA  31088
  10.  
  11.        -------------------------------------------------------------
  12.        This unit handles the objects for all dBase III index (.NDX)
  13.        operations.
  14.  
  15.        changes:
  16.  
  17.           16 Nov 90 - Modified KeyUpdate sub-procedure KeyInsert to
  18.                       test for end-of-file during search for key.
  19.  
  20.           22 Apr 91 - Modified SetMatchValue to be a method.  This will
  21.                       ensure consistency in building character and numeric
  22.                       values.  Also modified throughout to ensure the full
  23.                       length was loaded into Ndx_Key_St for a field rather
  24.                       than just moving length(Work_Key) characters.
  25.                       Also added comments for KeyUpdate procedures.
  26.  
  27.           02 May 91 - Added an IndexSignature constant so the GS_dBase unit
  28.                       can confirm this unit is the dBase III index unit.
  29.  
  30.  
  31.           01 Aug 91 -  Replaced string compare in DoMatchValue with call to
  32.                        GS_Sort_Compare for speed increase.
  33.  
  34. }
  35. {.pa}
  36. {
  37.  
  38.  
  39.                             ┌─────────────────────┐
  40.                             │  INTERFACE SECTION  │
  41.                             └─────────────────────┘
  42. }
  43.  
  44. unit GS_DBNdx;
  45.  
  46. (*$N+,E+*)                            {Numeric coprocessor or emulation is}
  47.                                       {required to handle the double type}
  48.                                       {that dBase uses to store number and}
  49.                                       {date fields. If not using date or }
  50.                                       {numeric values, 16K of memory can}
  51.                                       {be avoided by deleting this and}
  52.                                       {changing double types to integer}
  53.  
  54. interface
  55.  
  56. uses
  57.    GS_Strng,                          {String handler routines}
  58.    GS_Sort,                           {Sort/Compare routine}
  59.    GS_Error,                          {Error handler routines}
  60.    GS_FileH;                          {File handler routines}
  61.  
  62. const
  63.    NdxBufSize = 16384;
  64.    IndexSignature = 'NDX3';
  65.  
  66. type
  67.  
  68. {
  69.          ┌──────────────────────────────────────────────────────────┐
  70.          │  ********      Index Header Description       ********   │
  71.          │                                                          │
  72.          │  This record type describes the index file header.       │
  73.          │  This is a 512-byte block that is located at the         │
  74.          │  beginning of the index file.  Refer to Appendix C       │
  75.          │  for a description of the fields.                        │
  76.          └──────────────────────────────────────────────────────────┘
  77. }
  78.    GS_Indx_Head = Record
  79.                             Root        : Longint;
  80.                             Next_Blk    : Longint;
  81.                             Unknwn1     : Longint;
  82.                             Key_Lgth    : Integer;
  83.                             Max_Keys    : Integer;
  84.                             Data_Typ    : Integer;
  85.                             Entry_Sz    : Integer;
  86.                             Unknwn2     : Longint;
  87.                             Key_Form    : array [0..487] of char;
  88.                   end;
  89.  
  90. {
  91.          ┌──────────────────────────────────────────────────────────┐
  92.          │  ********   Index Node Header Description     ********   │
  93.          │                                                          │
  94.          │  This record type describes the index file node header.  │
  95.          │  Each node is a 512-byte block that is used as nodes     │
  96.          │  to store keys and pointers.  Refer to Appendix C        │
  97.          │  for a description of the fields.                        │
  98.          └──────────────────────────────────────────────────────────┘
  99. }
  100.  
  101.    GS_Indx_Data = Record
  102.                      Entry_Ct    : Integer;
  103.                      Unknwn1     : Integer;
  104.                      Data_Ary    : array [0..507] of byte;
  105.                                       {Memory array holding key entries}
  106.                      Filler1     : array [0..255] of byte;
  107.                                       {Filler for possible overflow during}
  108.                                       {insert mode.}
  109.                   end;
  110.  
  111.    GS_Indx_EntPtr = ^GS_Indx_Etry;    {Pointer of type GS_Indx_Etry.  Will}
  112.                                       {be used to reference key entries  }
  113.                                       {from GS_Indx_Data.Data_Ary.}
  114.  
  115. {
  116.          ┌──────────────────────────────────────────────────────────┐
  117.          │  ********   Index Node Key Entry Description   *******   │
  118.          │                                                          │
  119.          │  This record type describes the index file key entries.  │
  120.          │  Refer to Appendix C for a description of each field.    │
  121.          └──────────────────────────────────────────────────────────┘
  122. }
  123.  
  124.    GS_Indx_Etry = Record
  125.                      Block_Ax : Longint;
  126.                      Recrd_Ax : Longint;
  127.                      case Integer of
  128.                          0      : (Char_Fld : array [1..255] of char);
  129.                          1      : (Numb_Fld : double);
  130.                                       {dBase numeric and date fields are}
  131.                                       {stored as a floating point double}
  132.                  end;
  133.  
  134. {
  135.           ┌────────────────────────────────────────────────────────┐
  136.           │  Work table used to step through nodes.  The previous  │
  137.           │  nodes must be saved for finding the next or previous  │
  138.           │  record during sequential reads.                       │
  139.           └────────────────────────────────────────────────────────┘
  140. }
  141.     GS_Indx_Tabl = Record
  142.                       Page_No  : Longint;   {Disk block holding node info}
  143.                       Etry_No  : Longint;   {Last entry used in node}
  144.                       Last_One : Longint;   {Number of keys in this node }
  145.                       Node_Pag : Boolean;   {True for non-leaf nodes}
  146.                    end;
  147.  
  148.    GS_Indx_LPtr = ^GS_dBase_IX;       {Pointer to object.  Used by GS_dBase_DB}
  149.  
  150. {
  151.                       ┌─────────────────────────────────┐
  152.                       │  GS_dBase_IX Object Definition  │
  153.                       └─────────────────────────────────┘
  154. }
  155.  
  156.    GS_dBase_IX = object
  157.       Ndx_Name     : String[64];      {File name of index file}
  158.       Ndx_Hdr      : GS_Indx_Head;    {Index header information}
  159.       Ndx_File     : file;            {File type for index file}
  160.       Ndx_Tabl     : array [0..25] of GS_Indx_Tabl;
  161.                                       {Array of 25 table entries to hold}
  162.                                       {the trail of non-leaf nodes that are}
  163.                                       {traversed during a key search.  This }
  164.                                       {table is needed to track positions for}
  165.                                       {sequential reads (next and previous).}
  166.  
  167.       Ndx_Lvl      : integer;         {Holds counter into Ndx_Tabl}
  168.       Ndx_Data     : GS_Indx_Data;    {Node header information}
  169.       Ndx_Pntr     : GS_Indx_EntPtr;  {Pointer to key entry information}
  170.       Ndx_Key_St   : string[127];     {Holds last key value found on call to}
  171.                                       {either KeyRead or KeyFind}
  172.  
  173.       Ndx_Key_Num  : longint;         {Holds last physical record number for a}
  174.                                       {key value found on call to either}
  175.                                       {KeyRead or KeyFind}
  176.       Ndx_Key_Form : string[127];     {Holds the key formula in type string}
  177.       KeyEOF       : boolean;         {True if last KeyRead attempted to read}
  178.                                       {beyond the range of index keys - either}
  179.                                       {beyond beginning or end of file}
  180.       ExactMatch   : boolean;         {Flag for type of test to use in KeyFind}
  181.                                       {It will force a match against an entire}
  182.                                       {key if true, and only for the length of}
  183.                                       {the passed argument if false.  It is}
  184.                                       {initialized true.}
  185.  
  186.  
  187. {
  188.    ┌───────────────────────────────────────────────────────────────────────┐
  189.    │  ***  These methods are described individually in the following  ***  │
  190.    │       pages.  Their name describes their function.                    │
  191.    └───────────────────────────────────────────────────────────────────────┘
  192. }
  193.  
  194.       FUNCTION  Init(IName : String) : boolean;
  195.       FUNCTION  KeyFind(st : String) : longint;
  196.       FUNCTION  KeyLocRec(rec : longint) : boolean;
  197.       FUNCTION  KeyRead(a : LongInt) : longint;
  198.       PROCEDURE KeyUpdate (st : string; rec, crec : longint);
  199.       PROCEDURE Ndx_Close;
  200.       PROCEDURE Ndx_Get(blk : longint);
  201.       PROCEDURE Ndx_GetRecEntry;
  202.       PROCEDURE Ndx_GetRecPage(Ascnd : boolean);
  203.       FUNCTION  Ndx_LastEntry : boolean;
  204.       PROCEDURE Ndx_Make(filname, formla : string; lth : integer; typ : char);
  205.       PROCEDURE Ndx_NodeData(pn, en, lo : longint; np : boolean);
  206.       PROCEDURE Ndx_Put(blk : longint);
  207.       Procedure KeyList(st : string);
  208.       FUNCTION  SetMatchValue(st : string): string;
  209.  
  210.  
  211.  
  212.    end;
  213. {.pa}
  214. {
  215.                          ┌──────────────────────────┐
  216.                          │  IMPLEMENTATION SECTION  │
  217.                          └──────────────────────────┘
  218. }
  219.  
  220. implementation
  221.  
  222.  
  223. const
  224.  
  225.    Next_Record = -1;   {Token value passed to read next record}
  226.    Prev_Record = -2;   {Token value passed to read previous record}
  227.    Top_Record  = -3;   {Token value passed to read first record}
  228.    Bttm_Record = -4;   {Token value passed to read final record}
  229.  
  230.    ValueHigh   = 1;    {Token value passed for key comparison high}
  231.    ValueLow    = -1;   {Token value passed for key comparison low}
  232.    ValueEqual  = 0;    {Token value passed for key comparison equal}
  233.  
  234. var
  235.    Work_Key : string;               {Holds key passed in Find and KeyUpdate}
  236.    Work_Num : Double;               {Holds numeric value of Work_Key if needed}
  237.    RPag     : Longint;              {Work variable to hold current index block}
  238.    RNum     : Longint;              {Work variable for record number}
  239.    IsAscend : Boolean;              {Flag for ascending/descending status.}
  240.                                     {Set based on Next/Previous Record read}
  241.  
  242.  
  243. {.pa}
  244. {
  245.                                  Ndx_Make
  246.  
  247.      ╔══════════════════════════════════════════════════════════════════╗
  248.      ║                                                                  ║
  249.      ║   The Ndx_Make method will create an index file                  ║
  250.      ║                                                                  ║
  251.      ║       Calling the Method:                                        ║
  252.      ║                                                                  ║
  253.      ║           objectname.Ndx_Make(filname, formla, lth, typ)         ║
  254.      ║                                                                  ║
  255.      ║               ( where objectname is of type GS_dBase_IX          ║
  256.      ║                        filename is of type string                ║
  257.      ║                        formla is of type string)                 ║
  258.      ║                        lth is of type integer for key length     ║
  259.      ║                        typ is of type char for field type        ║
  260.      ║                                                                  ║
  261.      ║       Result:                                                    ║
  262.      ║                                                                  ║
  263.      ║           The index file is created.                             ║
  264.      ║                                                                  ║
  265.      ╚══════════════════════════════════════════════════════════════════╝
  266. }
  267.  
  268.  
  269. Procedure GS_dBase_IX.Ndx_Make(filname, formla : string; lth : integer;
  270.                                typ : char);
  271. begin
  272.    Ndx_Name := filname+'.NDX';        {Setup file name}
  273.    GS_FileAssign(Ndx_File,Ndx_Name,NdxBufSize);
  274.    GS_FileRewrite(Ndx_File,1);
  275.    FillChar(Ndx_Hdr, SizeOf(Ndx_Hdr),#0);
  276.    Ndx_Hdr.Root := 1;
  277.    Ndx_Hdr.Next_Blk := 2;
  278.    case typ of
  279.       'N',
  280.       'D'  : begin
  281.                 Ndx_Hdr.Data_Typ := 1;
  282.                 lth := 8;
  283.              end;
  284.       else Ndx_Hdr.Data_Typ := 0;
  285.    end;
  286.    Ndx_Hdr.Key_Lgth := lth;
  287.    Ndx_Hdr.Max_Keys := (SizeOf(Ndx_Hdr)-4) div (lth+8);
  288.    Ndx_Hdr.Entry_Sz := lth+8;
  289.    CnvStrToAsc(formla,Ndx_Hdr.Key_Form, length(formla)+1);
  290.    move(Ndx_Hdr, Ndx_Data, SizeOf(Ndx_Hdr));
  291.    Ndx_Put(0);
  292.    FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  293.    Ndx_Put(1);
  294. end;
  295. {.pa}
  296. {
  297.  
  298.                                     INIT
  299.  
  300.      ╔══════════════════════════════════════════════════════════════════╗
  301.      ║                                                                  ║
  302.      ║   The INIT method initializes objectname by reading the .NDX     ║
  303.      ║   file and loading file structure information into the object.   ║
  304.      ║                                                                  ║
  305.      ║       Calling the Method:                                        ║
  306.      ║                                                                  ║
  307.      ║           oldindex := objectname.Init(String)                    ║
  308.      ║                                                                  ║
  309.      ║               ( where oldindex is of type boolean,               ║
  310.      ║                       objectname is of type GS_dBase_IX,         ║
  311.      ║                       String is the file name of the dBase       ║
  312.      ║                       file (without the .NDX extension).         ║
  313.      ║                                                                  ║
  314.      ║       Result:                                                    ║
  315.      ║                                                                  ║
  316.      ║           Index file object is initialized.                      ║
  317.      ║           True will be returned if file exists.                  ║
  318.      ║                                                                  ║
  319.      ╚══════════════════════════════════════════════════════════════════╝
  320.  
  321.  
  322.                  ┌──────────────────────────────────────────┐
  323.                  │  The INIT method will do the following:  │
  324.                  │     1.  Open the index file              │
  325.                  │     2.  Read the first block (header)    │
  326.                  │         into objectname.                 │
  327.                  │     3.  Set Ndx_Lvl to zero, which will  │
  328.                  │         indicate no reads performed.     │
  329.                  │     4.  Return flag (false if new file)  │
  330.                  └──────────────────────────────────────────┘
  331. }
  332.  
  333. function GS_dBase_IX.Init(IName : String) : boolean;
  334. var
  335.    i : integer;
  336. begin
  337.    Ndx_Name := IName + '.NDX';
  338.    if GS_FileExists(Ndx_File, Ndx_Name) then
  339.    begin
  340.       GS_FileAssign(Ndx_File,Ndx_Name,NdxBufSize);
  341.       GS_FileReset(Ndx_File,1);
  342.       Init := true;
  343.    end
  344.    else
  345.    begin
  346.       ShowError(2,Ndx_Name);
  347.       Init := false;                  {return a flag showing no file}
  348.    end;
  349.    Ndx_Get(0);                        {Read first block of file for header info}
  350.                                       {Note that no error checking is done }
  351.                                       {in this version }
  352.    move(Ndx_Data, Ndx_Hdr, 512);      {Store in header info area}
  353.    Ndx_Lvl := 0;                      {Initialize the node step table}
  354.    Ndx_Tabl[0].Page_No := 0;
  355.    Ndx_Tabl[0].Etry_No := 0;
  356.    Ndx_Tabl[0].Last_One := 0;
  357.    KeyEOF := false;                   {Initialize EOF Flag to false}
  358.    ExactMatch := true;                {Initialize to use an exact match test}
  359. {
  360.                  ┌──────────────────────────────────────────┐
  361.                  │  This portion of code will extract the   │
  362.                  │  "formula", which is usually the field   │
  363.                  │  that is used for indexing.  However, it │
  364.                  │  can be compound (FLDA+FLDB).  The       │
  365.                  │  formula is placed in a string for use   │
  366.                  │  during index updates.                   │
  367.                  └──────────────────────────────────────────┘
  368. }
  369.    move(Ndx_Hdr.Key_Form[0], Ndx_Key_Form[1],100);
  370.    i := 1;
  371.    while Ndx_Key_Form[i] <> #0 do inc(i);
  372.    Ndx_Key_Form[0] := chr(pred(i));
  373.    Ndx_Key_Form := TrimR(Ndx_Key_Form);
  374.    Ndx_Key_Form := TrimL(Ndx_Key_Form);
  375. end;
  376. {.pa}
  377. {
  378.                     ┌─────────────────────────────────────┐
  379.                     │  This routine sets up the match     │
  380.                     │  string.  It sets the length of the │
  381.                     │  match for full or partial, and     │
  382.                     │  converts to numeric if needed.     │
  383.                     └─────────────────────────────────────┘
  384. }
  385. function GS_dBase_IX.SetMatchValue(st : string): string;
  386. var
  387.    rl : integer;
  388. begin
  389.    if Ndx_Hdr.Data_Typ = 0 then
  390.    begin                              {if a character key field then --}
  391.       FillChar(Work_Key[1], SizeOf(Work_Key), ' '); {Fill with blanks}
  392.       Work_Key := st;
  393.       if ExactMatch then
  394.       Work_Key[0] := chr(Ndx_Hdr.Key_Lgth);
  395.    end
  396.    else
  397.    begin
  398.       val(st,Work_Num,rl);
  399.       if rl <> 0 then ShowError(501,st);
  400.       move(Work_Num, Work_Key[1], 8);
  401.       Work_Key[0] := #8;
  402.    end;
  403.    SetMatchValue := Work_Key;
  404. end;
  405.  
  406. {.pa}
  407. {
  408.                                    KEYFIND
  409.  
  410.  
  411.      ╔══════════════════════════════════════════════════════════════════╗
  412.      ║                                                                  ║
  413.      ║   The KeyFind method will return the physical record location    ║
  414.      ║   of the record matching the key value passed as the argument.   ║
  415.      ║   ExactMatch controls the length of the match check.  If         ║
  416.      ║   ExactMatch is true, the entire key in the .NDX entry must      ║
  417.      ║   match the value passed.  If false, the check will only be      ║
  418.      ║   for the length of the string passed.                           ║
  419.      ║                                                                  ║
  420.      ║       Calling the Method:                                        ║
  421.      ║                                                                  ║
  422.      ║           longintvalu := objectname.KeyFind(string)              ║
  423.      ║                                                                  ║
  424.      ║               ( where objectname is of type GS_dBase_IX,         ║
  425.      ║                       string is a value used to search the       ║
  426.      ║                       .NDX file looking for a match.             ║
  427.      ║                                                                  ║
  428.      ║       Result:                                                    ║
  429.      ║                                                                  ║
  430.      ║       1.  longintvalu will point to the physical record,         ║
  431.      ║           or will be zero if no match.                           ║
  432.      ║       2.  Ndx_Key_St will contain the key value.                 ║
  433.      ║       3.  Ndx_Key_Num will contain the record number.            ║
  434.      ║                                                                  ║
  435.      ╚══════════════════════════════════════════════════════════════════╝
  436. }
  437.  
  438.  
  439. function GS_dBase_IX.KeyFind(st : string) : LongInt;
  440. var
  441.    i         : integer;               {Work variable}
  442.    rl        : integer;               {Result code for Val procedure}
  443.    ct        : integer;               {Variable to hold BlockRead byte count}
  444.    Less_Than : boolean;               {Flag to hunt for key match}
  445.    Loop_Cnt  : longint;
  446.    Match_Cnd : integer;
  447.  
  448.    procedure StoreMatchValue;
  449.    begin
  450.       move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  451.                                       {Move the key field to Ndx_Key_St.}
  452.       Ndx_Key_St[0] := Work_Key[0];   {Now insert the length into Ndx_Key_St}
  453.    end;
  454.  
  455.    function DoMatchValue : integer;
  456.    var
  457.       nks : double;
  458.    begin
  459.       if Ndx_Hdr.Data_Typ = 0 then    {Character key field}
  460.          Match_Cnd := GS_Sort_Compare(Ndx_Key_St, Work_Key)
  461.       else                            {Numeric key field}
  462.       begin
  463.          move(Ndx_Key_St[1],nks,8);
  464.          if nks > Work_Num then Match_Cnd := ValueHigh
  465.             else if nks = Work_Num then Match_Cnd := ValueEqual
  466.                else Match_Cnd := ValueLow;
  467.       end;
  468.       DoMatchValue := Match_Cnd;
  469.    end;
  470.  
  471. begin
  472.    KeyEOF := false;                   {Reset End-of-File to false}
  473.    Ndx_Key_Num := 0;                  {Initialize}
  474.    Ndx_Key_St := '';                  {Initialize}
  475.    Ndx_Lvl := 0;                      {Initialize index level}
  476.    Work_Key := SetMatchValue(st);     {Set key comparison value}
  477.    RPag := Ndx_Hdr.Root;              {Get root node address}
  478.    while RPag <> 0 do                 {While a non-leaf node, do this}
  479.    begin
  480.       Ndx_Get(RPag);                  {Get Node using RPag as block number}
  481.       Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[0]);
  482.                                       {Get pointer to first entry}
  483.       Loop_Cnt := Ndx_Pntr^.Block_Ax; {Get the next node pointer to see if it}
  484.                                       {is zero, meaning a leaf node}
  485.       i := 0;                         {Initialize i as counter}
  486.       Less_Than := Ndx_Data.Entry_Ct > 0;
  487.                                       {Start out with less than flag true}
  488.                                       {Will be false if Entry Count is 0}
  489.                                       {which means an empty node}
  490.       while (less_than) and (i <= Ndx_Data.Entry_Ct) do
  491.                                       {Hunt for a match.  If i = last entry in}
  492.                                       {the node, the last entry is used for}
  493.                                       {the next node search}
  494.       begin
  495.          Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[i *  Ndx_Hdr.Entry_Sz]);
  496.                                       {Get pointer to entry indexed by i}
  497.  
  498.          inc(i);                      {Increment the counter}
  499.          StoreMatchValue;             {Put the key value in Ndx_Key_St for}
  500.                                       {matching}
  501.  
  502.          Less_Than := DoMatchValue = ValueLow;
  503.                                       {Test looking for greater or equal than}
  504.                                       {the key value.  Less_Than will be set}
  505.                                       {false when found, setting the condition}
  506.                                       {to leave this portion of the routine}
  507.       end;
  508. {
  509.                  ┌──────────────────────────────────────────┐
  510.                  │  Save the node data for this node as:    │
  511.                  │  1.  Block Number from RPag.             │
  512.                  │  2.  Entry number of match or last one.  │
  513.                  │  3.  Set total number of entries.  This  │
  514.                  │      is entry count+1 for non-leaf nodes │
  515.                  │  4.  Set non-leaf flag to true.          │
  516.                  └──────────────────────────────────────────┘
  517. }
  518.       Ndx_NodeData(RPag,i,Ndx_Data.Entry_Ct+1,true);
  519.       if Loop_Cnt = 0 then RPag := 0
  520.          else RPag := Ndx_Pntr^.Block_Ax;
  521.                                       {Get the next node in the tree}
  522.    end;
  523.    Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  524.                                       {Set non-leaf flag to false for this}
  525.                                       {last level}
  526.    dec(Ndx_Tabl[Ndx_Lvl].Last_One);
  527.                                       {Set total number of entries to the }
  528.                                       {correct value for a leaf node}
  529.  
  530.  
  531.    if Ndx_Data.Entry_Ct = 0 then
  532.    begin
  533.       KeyFind := 0;
  534.       exit;
  535.    end;
  536.  
  537.    if (DoMatchValue <> ValueEqual) or
  538.       (Ndx_Tabl[Ndx_Lvl].Last_One < Ndx_Tabl[Ndx_Lvl].Etry_No)
  539.             then Ndx_Key_Num := 0     {if unable to find a match, the above}
  540.                                       {routine would have stopped when a}
  541.                                       {greater key was found, or would have}
  542.                                       {continued to Last_One.  Since the entry}
  543.                                       {count is one less for leaf nodes, even}
  544.                                       {if there was a match at Last_one, it is}
  545.                                       {not valid, and was only a coincidence.}
  546.                                       {In either case, set record number = 0.}
  547.    else
  548.       Ndx_Key_Num := Ndx_Pntr^.Recrd_Ax;
  549.                                       {When there is a match with the key,}
  550.                                       {get the physical record number}
  551.    KeyFind := Ndx_Key_Num;            {Return with the record number}
  552. end;
  553. {.pa}
  554. {
  555.                                   KEYLOCREC
  556.  
  557.  
  558.      ╔══════════════════════════════════════════════════════════════════╗
  559.      ║                                                                  ║
  560.      ║   The KeyLocRec method will search the .NDX file to find the     ║
  561.      ║   matching index entry pointing to the physical record location  ║
  562.      ║   of the record requested.                                       ║
  563.      ║                                                                  ║
  564.      ║       Calling the Method:                                        ║
  565.      ║                                                                  ║
  566.      ║           flag := objectname.KeyLocRec(key, position)            ║
  567.      ║                                                                  ║
  568.      ║               ( where objectname is of type GS_dBase_IX,         ║
  569.      ║                       key is the key string                      ║
  570.      ║                       position is the physical record number     ║
  571.      ║                          of the matching .DBF record.)           ║
  572.      ║                                                                  ║
  573.      ║       Result:                                                    ║
  574.      ║                                                                  ║
  575.      ║           Boolean True is returned if a match is found.          ║
  576.      ║           The current index entry will be set to the record      ║
  577.      ║           if a match does exist.                                 ║
  578.      ║                                                                  ║
  579.      ╚══════════════════════════════════════════════════════════════════╝
  580. }
  581.  
  582.  
  583. Function GS_dBase_IX.KeyLocRec (rec : longint) : boolean;
  584. var
  585.    lr : longint;
  586. begin
  587.    if rec = Ndx_Key_Num then
  588.    begin                              {Exit if already at the record}
  589.       KeyLocRec := true;
  590.       exit;
  591.    end;
  592.    lr := KeyRead(Top_Record);
  593.    while (not KeyEOF) and (lr <> rec) do lr := KeyRead(Next_Record);
  594.    if (KeyEOF) then KeyLocRec := false
  595.       else KeyLocRec := true;
  596. end;
  597. {.pa}
  598. {
  599.                                    KEYREAD
  600.  
  601.  
  602.      ╔══════════════════════════════════════════════════════════════════╗
  603.      ║                                                                  ║
  604.      ║   The KeyRead method will return the physical record location    ║
  605.      ║   of the record requested.  The only options that may be asked   ║
  606.      ║   for are Top, Bottom, Next, and Previous.                       ║
  607.      ║                                                                  ║
  608.      ║       Calling the Method:                                        ║
  609.      ║                                                                  ║
  610.      ║           longintvalu := objectname.KeyRead(position)            ║
  611.      ║                                                                  ║
  612.      ║               ( where objectname is of type GS_dBase_IX,         ║
  613.      ║                       position is in -1 to -4,                   ║
  614.      ║                       longintvalu is physical record number      ║
  615.      ║                          of the matching .DBF record.            ║
  616.      ║                                                                  ║
  617.      ║       Result:                                                    ║
  618.      ║                                                                  ║
  619.      ║           longintvalu will point to the physical record.         ║
  620.      ║                                                                  ║
  621.      ╚══════════════════════════════════════════════════════════════════╝
  622. }
  623.  
  624.  
  625. FUNCTION  GS_dBase_IX.KeyRead(a : longint) : longint;
  626. var
  627.    N_L_Hold   : Integer;              {Tempory variable for index level}
  628.    ct         : Integer;              {Work variable for Blockread count}
  629.  
  630.  
  631.  
  632. {
  633.                ┌───────────────────────────────────────────────┐
  634.                │  Start of KeyRead function.  This will        │
  635.                │  accomplish the following:                    │
  636.                │                                               │
  637.                │  1.  If first time for index, set any call    │
  638.                │      for a Next or Previous read to a Top     │
  639.                │      read command.                            │
  640.                │  2.  Use case select for Top/Bttm/Next/Prev.  │
  641.                │      Return physical .DBF record in RNum.     │
  642.                │  3.  If not a valid action, set RNum to 0.    │
  643.                │  4.  Move key value to Ndx_Key_St.            │
  644.                │  5.  Move RNum to Ndx_Key_Num.                │
  645.                │  6.  Return RNum value to calling procedure.  │
  646.                └───────────────────────────────────────────────┘
  647. }
  648.  
  649.  
  650. { Start of KeyRead }
  651.  
  652. begin
  653.    RNum := a;                         {Get action command}
  654.    if ((a = Next_Record) or (a = Prev_Record)) and
  655.       (Ndx_Lvl = 0) then RNum := Top_Record;
  656.                                       {if first time through, use Top_Record}
  657.                                       {command instead}
  658.    KeyEOF := false;                   {End-of-File initially set false}
  659.    case RNum of                       {Select KeyRead Action}
  660.  
  661.       Next_Record : begin
  662.                        IsAscend := true;
  663.                                       {Will be an ascending read}
  664.                        N_L_Hold := Ndx_Lvl;
  665.                                       {Save old index level}
  666. {
  667.                     ┌─────────────────────────────────────┐
  668.                     │  If the last record read was the    │
  669.                     │  last entry in the node, you have   │
  670.                     │  to step back through the index     │
  671.                     │  levels to find the next node.      │
  672.                     └─────────────────────────────────────┘
  673. }
  674.                        if Ndx_LastEntry then
  675.                                       {If last entry in node already used,}
  676.                                       {go find the next node}
  677.                        begin
  678.                           while (Ndx_LastEntry) and (Ndx_Lvl > 0) do
  679.                              dec(Ndx_Lvl);
  680.                                       {Step back through the levels until you}
  681.                                       {find a good one, or run out of levels.}
  682.  
  683.                           if Ndx_Lvl = 0 then
  684.                                       {if out of levels, process for EOF}
  685.                           begin
  686.                              Ndx_Lvl := N_L_Hold;
  687.                                       {Get old level number to restore}
  688.                              KeyEOF := true;
  689.                                       {Set End-of-File true}
  690.                           end else
  691.  
  692.                           begin       {Otherwise, get next entry data}
  693.                              inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  694.                                       {Step to next Entry Number}
  695.                              Ndx_GetRecEntry;
  696.                                       {Go search for next good record}
  697.                           end;
  698.                        end
  699.  
  700.                        else inc(Ndx_Tabl[Ndx_Lvl].Etry_No);
  701.                                       {Otherwise, just step to next entry}
  702.                        Ndx_Pntr :=
  703.                                     Addr(Ndx_Data.Data_Ary[(
  704.                                     (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  705.                                     Ndx_Hdr.Entry_Sz)]);
  706.                                       {Get pointer to the key entry}
  707.                        RNum := Ndx_Pntr^.Recrd_Ax;
  708.                                       {Get record number for the key entry}
  709.                     end;
  710.  
  711.       Prev_Record : begin
  712.                        IsAscend := false;
  713.                                       {Will be a descending read}
  714.                        N_L_Hold := Ndx_Lvl;
  715.                                       {Save old index level}
  716. {
  717.                     ┌─────────────────────────────────────┐
  718.                     │  If the last record read was the    │
  719.                     │  first entry in the node, you have  │
  720.                     │  to step back through the index     │
  721.                     │  levels to find the next node.      │
  722.                     └─────────────────────────────────────┘
  723. }
  724.                        if Ndx_Tabl[Ndx_Lvl].Etry_No = 1 then
  725.                                       {If last entry in node already used,}
  726.                                       {go find the next node}
  727.                        begin
  728.                           while (Ndx_Tabl[Ndx_Lvl].Etry_No = 1) and
  729.                                 (Ndx_Lvl > 0) do
  730.                              dec(Ndx_Lvl);
  731.                                       {Step back through the levels until you}
  732.                                       {find a good one, or run out of levels.}
  733.  
  734.                           if Ndx_Lvl = 0 then
  735.                                       {if out of levels, process for EOF}
  736.                           begin
  737.                              Ndx_Lvl := N_L_Hold;
  738.                                       {Get old level number to restore}
  739.                              KeyEOF := true;
  740.                                       {Set End-of-File true}
  741.                           end else
  742.  
  743.                           begin       {Otherwise, get next entry data}
  744.                              dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  745.                                       {Step to next Entry Number}
  746.                              Ndx_GetRecEntry;
  747.                                       {Go search for next good record}
  748.                           end;
  749.                        end
  750.                        else dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  751.                                       {Otherwise, just step to next entry}
  752.                        Ndx_Pntr :=
  753.                                     Addr(Ndx_Data.Data_Ary[(
  754.                                     (Ndx_Tabl[Ndx_Lvl].Etry_No - 1) *
  755.                                     Ndx_Hdr.Entry_Sz)]);
  756.                                       {Get pointer to the key entry}
  757.                        RNum := Ndx_Pntr^.Recrd_Ax;
  758.                                       {Get record number for the key entry}
  759.                     end;
  760.  
  761.       Top_Record,
  762.       Bttm_Record : begin
  763.                        IsAscend := Top_Record = RNum;
  764.                                       {Ascending search if Top, otherwise}
  765.                                       {descending.  An ascending search will}
  766.                                       {return the first index key as the Top.}
  767.                                       {A descending search will return the}
  768.                                       {last index key as the 'Top'}
  769.                        Ndx_Lvl := 0;  {Clear index levels for new stack}
  770.                        RPag := Ndx_Hdr.Root;
  771.                                       {Get root node address}
  772.                        Ndx_GetRecPage(IsAscend);
  773.                                       {Go get valid record}
  774.                     end;
  775.  
  776.       else          RNum := 0;        {If no valid action, return zero}
  777.    end;
  778.    move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  779.                                       {Move the key field to Ndx_Key_St.}
  780.                                       {The Move procedure must be used since}
  781.                                       {Char_Fld is not a true Pascal string.}
  782.    Ndx_Key_St[0] := chr(Ndx_Hdr.Key_Lgth);
  783.                                       {Now insert the length into Ndx_Key_St}
  784.                                       {so it is a valid string we can use}
  785.  
  786.    Ndx_Key_Num := RNum;               {Save RNum in Ndx_Key_Num}
  787.    KeyRead := RNum;                   {Return RNum}
  788. end;
  789. {.pa}
  790. {
  791.                                  NDX_CLOSE
  792.  
  793.  
  794.      ╔══════════════════════════════════════════════════════════════════╗
  795.      ║                                                                  ║
  796.      ║   The Ndx_Close method will close the index file from this       ║
  797.      ║   object.                                                        ║
  798.      ║                                                                  ║
  799.      ║       Calling the Method:                                        ║
  800.      ║                                                                  ║
  801.      ║           objectname.Ndx_Close                                   ║
  802.      ║                                                                  ║
  803.      ║               ( where objectname is of type GS_dBase_IX          ║
  804.      ║                                                                  ║
  805.      ║       Result:                                                    ║
  806.      ║                                                                  ║
  807.      ║           The index file is closed.                              ║
  808.      ║                                                                  ║
  809.      ╚══════════════════════════════════════════════════════════════════╝
  810. }
  811.  
  812.  
  813. Procedure GS_dBase_IX.Ndx_Close;
  814. begin
  815.    GS_FileClose(Ndx_File);
  816. end;
  817.  
  818. {.pa}
  819. {
  820.                                   NDX_GET
  821.  
  822.  
  823.      ╔══════════════════════════════════════════════════════════════════╗
  824.      ║                                                                  ║
  825.      ║   The Ndx_Get method will read a block from the index file for   ║
  826.      ║   this object.                                                   ║
  827.      ║                                                                  ║
  828.      ║       Calling the Method:                                        ║
  829.      ║                                                                  ║
  830.      ║           objectname.Ndx_Get(Blk)                                ║
  831.      ║                                                                  ║
  832.      ║               ( where objectname is of type GS_dBase_IX          ║
  833.      ║                       blk is longint number of block to read)    ║
  834.      ║                                                                  ║
  835.      ║       Result:                                                    ║
  836.      ║                                                                  ║
  837.      ║           The index block (node) is read into Ndx_Data           ║
  838.      ║                                                                  ║
  839.      ╚══════════════════════════════════════════════════════════════════╝
  840. }
  841.  
  842.  
  843. Procedure GS_dBase_IX.Ndx_Get(blk : longint);
  844. var
  845.    r : word;
  846. begin
  847.    GS_FileRead(Ndx_File,blk*512,Ndx_Data,512,r);
  848.    if r < 512 then ShowError(100,'Ndx_Get');
  849. end;
  850.  
  851. Procedure GS_dBase_IX.Ndx_NodeData(pn, en, lo : longint; np : boolean);
  852. begin
  853.    inc(Ndx_Lvl);                      {Prepare to store node information as}
  854.                                       {part of the Ndx_Lvl hierarchy}
  855.    with Ndx_Tabl[Ndx_Lvl] do          {Use the index level entry}
  856.    begin
  857.       Page_No := pn;                  {Save Block number}
  858.       Etry_No := en;                  {Set entry number}
  859.       Last_One := lo;                 {Set total number of entries.}
  860.       Node_Pag := np;                 {Set non-leaf flag}
  861.    end;
  862. end;
  863.  
  864. {
  865.                     ┌─────────────────────────────────────┐
  866.                     │  This procedure will locate the     │
  867.                     │  starting page to search for an     │
  868.                     │  entry.  It selects the entry       │
  869.                     │  number contained at the present    │
  870.                     │  index level and passes its node    │
  871.                     │  pointer to Get_PageRec.  This is   │
  872.                     │  needed to read the index blocks in │
  873.                     │  the correct sequence.              │
  874.                     └─────────────────────────────────────┘
  875. }
  876.  
  877. procedure GS_dBase_IX.Ndx_GetRecEntry;
  878. begin
  879.    RPag := Ndx_Tabl[Ndx_Lvl].Page_No;
  880.                                       {Get page number for this index level}
  881.    Ndx_Get(RPag);                     {Get Node using RPag as block number}
  882.    Ndx_Pntr := Addr(Ndx_Data.Data_Ary[(Ndx_Tabl[Ndx_Lvl].Etry_No- 1)
  883.                                           * Ndx_Hdr.Entry_Sz]);
  884.                                       {Get pointer to key entry (relative zero)}
  885.    RPag := Ndx_Pntr^.Block_Ax;        {Get Next node number in RPag}
  886.    Ndx_GetRecPage(IsAscend);          {Go get the next record from a non-leaf}
  887.                                       {node.  Pass the argument for either an}
  888.                                       {ascending or descending search}
  889. end;
  890. {
  891.                     ┌─────────────────────────────────────┐
  892.                     │  This procedure will step the nodes │
  893.                     │  until it finds a leaf node.  The   │
  894.                     │  starting node is contained in the  │
  895.                     │  variable RPag; the record number   │
  896.                     │  of the first or last key (based)   │
  897.                     │  on Ascnd) will be placed in RNum.  │
  898.                     └─────────────────────────────────────┘
  899. }
  900. procedure GS_dBase_IX.Ndx_GetRecPage(Ascnd : boolean);
  901. var
  902.    ec : integer;                      {Work variable for entry count}
  903. begin
  904.     while RPag <> 0 do                {Next node number in RPag will be zero}
  905.                                       {when taken from a leaf node.}
  906.     begin
  907.        Ndx_Get(RPag);                 {Get Node using RPag as block number}
  908.        Ndx_NodeData(RPag,0,Ndx_Data.Entry_Ct+1,true);
  909.                                       {Store Node data}
  910. {
  911.                ┌───────────────────────────────────────────────┐
  912.                │  This portion of code checks to see if called │
  913.                │  by Next/Top or Bttm/Prev, and sets the entry │
  914.                │  to 1 or last node entry, based on Ascnd      │
  915.                └───────────────────────────────────────────────┘
  916. }
  917.        if Ascnd then
  918.        begin
  919.           ec := 0;                    {Set ec = first entry (relative zero)}
  920.           Ndx_Tabl[Ndx_Lvl].Etry_No := 1;
  921.                                       {Set Entry Number in table to first one}
  922.        end else
  923.        begin
  924.           ec := Ndx_Data.Entry_Ct;    {Set ec to last entry (relative zero)}
  925.                                       {Note there are Entry_Ct+1 entries for}
  926.                                       {non-leaf nodes.  It will be adjusted}
  927.                                       {later if it is a leaf node}
  928.           Ndx_Tabl[Ndx_Lvl].Etry_No := ec+1;
  929.                                       {Set Entry Number in table to last one}
  930.        end;
  931.  
  932.        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[ec * Ndx_Hdr.Entry_Sz]);
  933.                                       {Get pointer to correct entry in node}
  934.        RPag := Ndx_Pntr^.Block_Ax;    {Get Next node number in RPag}
  935.     end;
  936. {
  937.                ┌───────────────────────────────────────────────┐
  938.                │  This portion of code checks to see if the    │
  939.                │  index file is empty.  If so, the EOF is set  │
  940.                │  and the routine is quit.                     │
  941.                └───────────────────────────────────────────────┘
  942. }
  943.     if Ndx_Data.Entry_Ct = 0 then
  944.     begin
  945.        KeyEOF := true;
  946.        RNum := 0;
  947.        exit;
  948.     end;
  949.     Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  950.                                       {Set non-leaf flag to false for leaf}
  951.     if not Ascnd then
  952.     begin
  953.        dec(Ndx_Tabl[Ndx_Lvl].Etry_No);
  954.                                       {Set Entry Number in table to last one}
  955.                                       {for a non-leaf node}
  956.        Ndx_Pntr := Addr(Ndx_Data.Data_Ary[ec-1 * Ndx_Hdr.Entry_Sz]);
  957.                                       {Get pointer to correct leaf entry for}
  958.                                       {the last entry in the node}
  959.     end;
  960.     Ndx_Tabl[Ndx_Lvl].Node_Pag := false;
  961.                                       {Set non-leaf flag to false for this}
  962.                                       {last level}
  963.     dec(Ndx_Tabl[Ndx_Lvl].Last_One);  {Set total number of entries to the }
  964.                                       {correct value for a leaf node}
  965.     RNum := Ndx_Pntr^.Recrd_Ax;       {Get the physical record number for}
  966.                                       {the first key entry}
  967. end;
  968.  
  969. {
  970.                ┌───────────────────────────────────────────────┐
  971.                │  This function will return true if all        │
  972.                │  entries have been processed in the           │
  973.                │  Ndx_Lvl layer number passed to the function  │
  974.                └───────────────────────────────────────────────┘
  975. }
  976.  
  977. function GS_dBase_IX.Ndx_LastEntry : boolean;
  978. begin
  979.    if Ndx_Tabl[Ndx_Lvl].Etry_No = Ndx_Tabl[Ndx_Lvl].Last_One then
  980.        Ndx_LastEntry := true else Ndx_LastEntry := false;
  981. end;
  982. {.pa}
  983. {
  984.                                   NDX_PUT
  985.  
  986.  
  987.      ╔══════════════════════════════════════════════════════════════════╗
  988.      ║                                                                  ║
  989.      ║   The Ndx_Put method will write a block from the index file for  ║
  990.      ║   this object.                                                   ║
  991.      ║                                                                  ║
  992.      ║       Calling the Method:                                        ║
  993.      ║                                                                  ║
  994.      ║           objectname.Ndx_Put(Blk)                                ║
  995.      ║                                                                  ║
  996.      ║               ( where objectname is of type GS_dBase_IX          ║
  997.      ║                       blk is longint number of block to write)   ║
  998.      ║                                                                  ║
  999.      ║       Result:                                                    ║
  1000.      ║                                                                  ║
  1001.      ║           The index block (node) is written from Ndx_Data        ║
  1002.      ║                                                                  ║
  1003.      ╚══════════════════════════════════════════════════════════════════╝
  1004. }
  1005.  
  1006.  
  1007. Procedure GS_dBase_IX.Ndx_Put(blk : longint);
  1008. var
  1009.    r : word;
  1010. begin
  1011.    GS_FileWrite(Ndx_File,blk*512,Ndx_Data,512,r);
  1012.    if r < 512 then ShowError(101,'Ndx_Put');
  1013. end;
  1014.  
  1015.  
  1016. Procedure GS_dBase_IX.KeyUpdate (st : string; rec, crec : longint);
  1017. var
  1018.    ct : integer;
  1019.    nu_key : longint;
  1020.    em_hold : boolean;                 {holds ExactMatch flag during this}
  1021.    t_num  : double;
  1022.    lr,
  1023.    b1,
  1024.    b2  : longint;
  1025.    rlst,
  1026.    e1,
  1027.    e2,
  1028.    n1,
  1029.    n2  : integer;
  1030.    s1,
  1031.    s2  : string[127];
  1032.    r1  : GS_Indx_Data;
  1033.  
  1034. {
  1035.    This routine deletes the current entry by overlaying the remaining entries
  1036.    over the entry location, and then decrementing the entry count
  1037. }
  1038.    Procedure DeleteEntry;
  1039.    begin
  1040.       with Ndx_Tabl[Ndx_Lvl] do
  1041.       begin
  1042.          move(Ndx_Data.Data_Ary[(Etry_No)*Ndx_Hdr.Entry_Sz],
  1043.               Ndx_Data.Data_Ary[(Etry_No-1)*Ndx_Hdr.Entry_Sz],
  1044.               Ndx_Hdr.Entry_Sz*(Last_One-Etry_No));
  1045.          dec(Last_One);
  1046.          dec(Ndx_Data.Entry_Ct);
  1047.       end;
  1048.    end;
  1049.  
  1050.  
  1051. {  This routine inserts an entry by making room in the current data array
  1052.    and inserting the new entry.  The entry count is then incremented.
  1053. }
  1054.    Procedure InsertEntry;
  1055.    begin
  1056.       with Ndx_Tabl[Ndx_Lvl] do
  1057.       begin
  1058.          if (Etry_No <> 0) and (not KeyEOF) then
  1059.          begin                        {If at a valid entry number and not}
  1060.                                       {at EOF, make room for the entry.  }
  1061.             move(Ndx_Data.Data_Ary[(Etry_No-1)*Ndx_Hdr.Entry_Sz],
  1062.                  Ndx_Data.Data_Ary[(Etry_No)*Ndx_Hdr.Entry_Sz],
  1063.                  Ndx_Hdr.Entry_Sz*(((Last_One-Etry_No)+1)));
  1064.             Ndx_Pntr := Addr(Ndx_Data.Data_Ary[(Etry_No-1) * Ndx_Hdr.Entry_Sz]);
  1065.          end
  1066.          else
  1067.          begin                        {else put entry at end of array}
  1068.             Ndx_Pntr := Addr(Ndx_Data.Data_Ary[Etry_No*Ndx_Hdr.Entry_Sz]);
  1069.             inc(Etry_No);
  1070.          end;
  1071.          inc(Last_One);               {account for additional entry}
  1072.          inc(Ndx_Data.Entry_Ct);      {account for additional entry}
  1073.          move(Work_Key[1],Ndx_Pntr^.Char_Fld,Ndx_Hdr.Key_Lgth)
  1074.                                       {Move the key field from Work_Key.}
  1075.                                       {The Move procedure must be used since}
  1076.                                       {Char_Fld is not a true Pascal string.}
  1077.       end;
  1078.    end;
  1079.  
  1080. {  This routine searches back through the nodes to replace the key value in
  1081.    the non-leaf node.
  1082. }
  1083.    procedure ReplacePointerEntry;
  1084.    begin
  1085.       while (Ndx_LastEntry) and (Ndx_Lvl > 0) do dec(Ndx_Lvl);
  1086.                                       {Search for entry that requires the key}
  1087.                                       {value.  Value is not needed for the   }
  1088.                                       {last entry in a non-leaf node.  Thus, }
  1089.                                       {this searches until it finds a pointer}
  1090.                                       {that is not the last entry in a node, }
  1091.                                       {or until the root node is reached.    }
  1092.       if Ndx_Lvl > 0 then
  1093.       begin                           {Replace key value with new one if not }
  1094.                                       {the last entry in the root node.      }
  1095.          Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1096.                                       {Get the correct index node.}
  1097.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1098.                           [(Ndx_Tabl[Ndx_Lvl].Etry_No-1) * Ndx_Hdr.Entry_Sz]);
  1099.                                       {Get entry that pointed to the leaf node}
  1100.          move(Ndx_Key_St[1],Ndx_Pntr^.Char_Fld,Ndx_Hdr.Key_Lgth);
  1101.                                       {Move the key field from Ndx_Key_St.}
  1102.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1103.                                       {Write updated node to disk}
  1104.       end;
  1105.    end;
  1106.  
  1107.  
  1108. {  This routine is used to delete all references to a record key.  It will
  1109.    delete the key from the leaf node, and then search the non-leaf node and
  1110.    replace the pointer if it was the last entry in the non-leaf node.
  1111. }
  1112.    Procedure KeyDelete;
  1113.    begin
  1114.       DeleteEntry;                    {delete the key from this node.}
  1115.       Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1116.                                       {write the updated node.}
  1117.       if Ndx_Tabl[Ndx_Lvl].Last_One = 0 then
  1118.       begin                           {if this was the only entry, then }
  1119.                                       {go delete any previous references}
  1120.                                       {to the node.                     }
  1121.          dec(Ndx_Lvl);
  1122.          if Ndx_Lvl > 0 then
  1123.          begin                        {this will be recursive until it  }
  1124.                                       {steps past the root node.        }
  1125.             Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1126.                                       {Get the node.}
  1127.             KeyDelete;                {and delete the pointer.}
  1128.          end;
  1129.          exit;                        {leave this procedure when all the}
  1130.                                       {references are deleted.          }
  1131.       end;
  1132.  
  1133.       if Ndx_Tabl[Ndx_Lvl].Etry_No > Ndx_Tabl[Ndx_Lvl].Last_One then
  1134.       begin                           {if this was the last entry in the node,}
  1135.                                       {make sure non-leaf node pointers use   }
  1136.                                       {the predecessor key value.             }
  1137.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1138.                            [(Ndx_Tabl[Ndx_Lvl].Last_One-1) * Ndx_Hdr.Entry_Sz]);
  1139.                                       {point to the predecessor entry.}
  1140.          move(Ndx_Pntr^.Char_Fld,Ndx_Key_St[1],Ndx_Hdr.Key_Lgth);
  1141.                                       {Move the key field to Ndx_Key_St.}
  1142.                                       {The Move procedure must be used since}
  1143.                                       {Char_Fld is not a true Pascal string.}
  1144.          Ndx_Key_St[0] := chr(length(Work_Key));
  1145.                                       {Now insert the length into Ndx_Key_St}
  1146.                                       {so it is a valid string we can use}
  1147.          dec(Ndx_Lvl);
  1148.          if Ndx_Lvl > 0 then ReplacePointerEntry;
  1149.                                       {replace the node pointer with this new key}
  1150.       end;
  1151.    end;
  1152.  
  1153.  
  1154. {  This routine will divide a block into two equal blocks and then store the
  1155.    index levels (n1 and n2), entry counts (e1 and e2), and block numbers
  1156.    (b1 and b2) for later node pointer updates.  The new key (from the middle
  1157.    of the block's entries) will be saved in s1.
  1158. }
  1159.    Procedure SplitBlock;
  1160.    begin
  1161.       b1 := Ndx_Hdr.Next_Blk;         {Get the next available block.}
  1162.       inc(Ndx_Hdr.Next_Blk);          {Update the next available block.}
  1163.       Ndx_NodeData(b1,1,Ndx_Tabl[Ndx_Lvl].Last_One,Ndx_Tabl[Ndx_Lvl].Node_Pag);
  1164.                                       {make a new index table entry}
  1165.       with Ndx_Tabl[Ndx_Lvl] do
  1166.       begin                           {put the first half of the block in the}
  1167.                                       {new block.  Adjust the entry and last }
  1168.                                       {one counts accordingly.               }
  1169.          n1 := Ndx_Lvl;
  1170.          Ndx_Data.Entry_Ct := Last_One div 2;
  1171.                                       {Number of entries in first half.}
  1172.          e2 := Last_One - Ndx_Data.Entry_Ct;
  1173.                                       {Number of entries in second half.}
  1174.          Last_One := Ndx_Data.Entry_Ct;
  1175.          e1 := Last_One;
  1176.          if Node_Pag then dec(Ndx_Data.Entry_Ct);
  1177.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary
  1178.                           [(Ndx_Tabl[Ndx_Lvl].Last_One-1) * Ndx_Hdr.Entry_Sz]);
  1179.          move(Ndx_Pntr^.Char_Fld,s1[1],Ndx_Hdr.Key_Lgth);
  1180.          s1[0] := chr(Ndx_Hdr.Key_Lgth);
  1181.                                       {Save the last key entry in the block.}
  1182.          Ndx_Put(Page_No);            {Save the block.}
  1183.       end;
  1184.       dec(Ndx_Lvl);
  1185.       with Ndx_Tabl[Ndx_Lvl] do
  1186.       begin
  1187.          b2 := Page_No;
  1188.          n2 := Ndx_Lvl;
  1189.          Last_One := e2;
  1190.          Ndx_Data.Entry_Ct := e2;
  1191.          if Node_Pag then dec(Ndx_Data.Entry_Ct);
  1192.          move(Ndx_Data.Data_Ary[e1*Ndx_Hdr.Entry_Sz],
  1193.               Ndx_Data.Data_Ary[0],Ndx_Hdr.Entry_Sz*(e2));
  1194.                                       {Shift second half to beginning of the}
  1195.                                       {buffer array.}
  1196.          Ndx_Put(Page_No);            {Save the block}
  1197.          move(Ndx_Hdr, Ndx_Data, 512);
  1198.                                       {Store from header info area}
  1199.          Ndx_Put(0);
  1200.          dec(Ndx_Lvl);                {Step back to previous node.}
  1201.       end;
  1202.    end;
  1203.  
  1204.  
  1205. {  This routine is used to create a new root node when the split block
  1206.    pointers will not fit in the current root node.
  1207. }
  1208.    Procedure MakeRootNode;
  1209.    begin
  1210.       Ndx_Lvl := 0;
  1211.       with Ndx_Tabl[Ndx_Lvl] do
  1212.       begin
  1213.          Page_No := Ndx_Hdr.Next_Blk; {Get next available block.}
  1214.          inc(Ndx_Hdr.Next_Blk);       {Increment the next available block.}
  1215.          Ndx_Hdr.Root := Page_No;     {Set root pointer to this block.}
  1216.          move(Ndx_Hdr, Ndx_Data, 512);
  1217.                                       {Store from header info area}
  1218.          Ndx_Put(0);                  {Write updated header block.}
  1219.          Ndx_Pntr := Addr(Ndx_Data.Data_Ary[0]);
  1220.          Ndx_Data.Entry_Ct := 0;
  1221.          Ndx_Pntr^.Recrd_Ax := 0;
  1222.          Ndx_Pntr^.Block_Ax := b2;
  1223.          Last_One := 1;
  1224.          Etry_No := 1;
  1225.          Ndx_Put(Page_No);
  1226.       end;
  1227.    end;
  1228.  
  1229.  
  1230. {  This routine will split the current node, create a new root node if needed,
  1231.    and then insert the newly created block in the proper sequence in the node.
  1232. }
  1233.    procedure ExpandIndex;
  1234.    var
  1235.       kEOF : boolean;
  1236.    begin
  1237.       SplitBlock;
  1238.       if Ndx_Lvl = 0 then MakeRootNode;
  1239.       Work_Key := s1;
  1240.       Ndx_Get(Ndx_Tabl[Ndx_Lvl].Page_No);
  1241.                                       {Get the proper non-leaf node}
  1242.       kEOF := KeyEOF;
  1243.       KeyEOF := false;                {temporarily turn off EOF flag}
  1244.       InsertEntry;
  1245.       KeyEOF := kEOF;
  1246.       Ndx_Pntr^.Recrd_Ax := 0;
  1247.       Ndx_Pntr^.Block_Ax := b1;
  1248.       if Ndx_Tabl[Ndx_Lvl].Last_One <= Ndx_Hdr.Max_Keys then
  1249.                                       {test to see if more entries than the}
  1250.                                       {maximum allowed.                    }
  1251.       begin                           {write the block if below the max.   }
  1252.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1253.       end else
  1254.       begin
  1255.          ExpandIndex;                 {Keep expanding recursively as long as}
  1256.                                       {is necessary.                        }
  1257.       end;
  1258.    end;
  1259.  
  1260.  
  1261. {  This routine will insert the new key into the index.  It will search for
  1262.    matching keys and insert the new key after any existing matches.  It will
  1263.    then check to see if the node is filled, and split the block if necessary.
  1264. }
  1265.    Procedure KeyInsert;
  1266.    begin
  1267.       nu_key := KeyFind(st);          {Find a matching key.}
  1268.       if nu_key <> 0 then             {If there is a match, continue looking}
  1269.       begin                           {until no more matches.               }
  1270.          if Ndx_Hdr.Data_Typ = 0 then
  1271.                                       {Search for character string keys}
  1272.             while (Ndx_Key_St = Work_Key) and (not KeyEOF) do
  1273.                nu_key := KeyRead(Next_Record)
  1274.          else
  1275.          begin                        {Search for numeric and date keys}
  1276.             move(Ndx_Key_St[1],t_num,8);
  1277.             while (t_num = Work_Num) and (not KeyEOF) do
  1278.                nu_key := KeyRead(Next_Record);
  1279.          end;
  1280.       end;
  1281.       InsertEntry;                    {Insert the key here}
  1282.       Ndx_Pntr^.Recrd_Ax := rec;
  1283.       Ndx_Pntr^.Block_Ax := 0;
  1284.       if Ndx_Tabl[Ndx_Lvl].Etry_No > Ndx_Tabl[Ndx_Lvl].Last_One then
  1285.                                       {See if this is the last entry in the }
  1286.                                       {leaf node.  If so, go replace the old}
  1287.                                       {pointer in the non-leaf node.        }
  1288.       begin
  1289.          r1 := Ndx_Data;
  1290.          n1 := Ndx_Lvl;
  1291.          Ndx_Key_St := Work_Key;
  1292.          ReplacePointerEntry;
  1293.          Ndx_Lvl := n1;
  1294.          Ndx_Data := r1;
  1295.       end;
  1296.       if Ndx_Tabl[Ndx_Lvl].Last_One <= Ndx_Hdr.Max_Keys then
  1297.                                       {if fewer than the maximum number of key}
  1298.                                       {entries allowed, write the updated node}
  1299.       begin
  1300.          Ndx_Put(Ndx_Tabl[Ndx_Lvl].Page_No);
  1301.       end else
  1302.       begin
  1303.          ExpandIndex;                 {otherwise, split the block.}
  1304.       end;
  1305.    end;
  1306.  
  1307. begin
  1308.    Work_Key := SetMatchValue(st);     {Set key comparison value}
  1309.    if rec = crec then                 {Tests for Append vs Update}
  1310.    begin
  1311.       if Work_Key = Ndx_Key_St then exit;
  1312.       KeyDelete;
  1313.    end;
  1314.    em_hold := ExactMatch;
  1315.    ExactMatch := true;
  1316.    KeyInsert;
  1317.    ExactMatch := em_hold;
  1318.    if crec < 0 then exit;
  1319.    lr := KeyFind(st);
  1320.    while lr <> rec do lr := KeyRead(Next_Record);
  1321. end;
  1322.  
  1323. Procedure GS_dBase_IX.KeyList(st : string);
  1324. var
  1325.    ofil      : text;
  1326.    RPag      : LongInt;
  1327.    Lst_One,
  1328.    i,j,k,v   : integer;
  1329.    rl        : integer;
  1330.    ct        : integer;
  1331.    recnode,
  1332.    Less_Than : boolean;
  1333. begin
  1334.    assign(ofil, st);
  1335.    ReWrite(ofil);
  1336.    with Ndx_Hdr do
  1337.    begin
  1338.       writeln(ofil,'--------------------------------------------------');
  1339.       writeln(ofil,'':8,Ndx_Key_St);
  1340.       writeln(ofil,'Root =',Root:3,'   Next Block Available:',Next_Blk:3);
  1341.    end;
  1342.    RPag := 1;
  1343.    while RPag <> Ndx_Hdr.Next_Blk do
  1344.    begin
  1345.       Seek(Ndx_File,RPag*512);
  1346.       BlockRead(Ndx_File,Ndx_Data,512,ct);
  1347.       Lst_One := Ndx_Data.Entry_Ct+1;
  1348.       write(ofil,RPag:2,'  [',Ndx_Data.Entry_Ct,']');
  1349.       Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[0]);
  1350.       recnode := Ndx_Pntr^.Block_Ax = 0;
  1351.       k := Lst_One;
  1352.       if recnode then dec(k);
  1353.       v := 1;
  1354.       i := 1;
  1355.       while (i <= k) do
  1356.       begin
  1357.          Ndx_Pntr :=  Addr(Ndx_Data.Data_Ary[((i-1) *  Ndx_Hdr.Entry_Sz)]);
  1358.          with Ndx_Pntr^ do
  1359.          begin
  1360.             write(ofil,'':v,Block_Ax:5);
  1361.             v := 9;
  1362.             if i = Lst_One then write(ofil,'    0 - empty')
  1363.             else
  1364.                begin
  1365.                   write(ofil,Recrd_Ax:5,' ');
  1366.                   if Ndx_Hdr.Data_Typ <> 0 then
  1367.                      write(ofil,Numb_Fld)
  1368.                   else
  1369.                      for j := 1 to Ndx_Hdr.Key_Lgth do
  1370.                         write(ofil,Char_Fld[j]);
  1371.                end;
  1372.          WRITELN(OFIL);
  1373.          end;
  1374.          inc(i);
  1375.       end;
  1376.       writeln(ofil);
  1377.       inc(RPag);
  1378.    end;
  1379.    System.Close(ofil);
  1380. end;
  1381.  
  1382.  
  1383.  
  1384.  
  1385. end.
  1386.  
  1387.